AltME groups: search

is: func [
		[catch]
		{Current face inherits from a block!}
		spec [block!]
		/local locals old when init
	][
		either all [
			find spec set-word!	; locals founds
			not empty? exclude  ; new ones (not found in the current face)

    first locals: construct copy spec ; copy: because [construct] modifies 
    the block (R2 bug ?)
				first face
		][

   ; Would be simpler, faster and safer using R3 (objects can be expanded)
			; rebuild face with new locals 

   ; (make face spec : can't be used here because of the special bounding 
   rules)

   when: face/when					; prevent copy/deep of when and init blocks
			init: face/init
			face/when: face/init: none
			set locals none

   resolve* locals face			; initialize locals with current face (if 
   intersect)

   face: make old: face locals		; rebuild current face with new locals
			face/when: when
			face/init: init
			do-safe bind bind spec face self; run style constructor 

   bind bind init face self		; rebound current face constructor (which 
   is currently running)

   error? set old :bound-err		; prevent old object from being used anymore
			old: none
		][
			; no new locals

   do-safe bind bind spec face self		; just run style's constructor 
		]
		if error throw-exit
	]

I've been very busy since yesterday on a new tool for Red: I've built 
a proper REBOL code profiler! (I wonder why I haven't done that since 
a long time...). I went through the profiler scripts on rebol.org 
and couldn't one suitable for my needs or that works with complex 
code, so I wrote one. It is able to deal with complex code, all datatypes, 
recursive calls and it's very simple to use.


Here's a demo profiling Red compiler (output is properly aligned 
when monospace font is used):

-= Red Compiler =-
Compiling red/tests/test.red ...

...compilation time:     40 ms

Compiling to native code...

...compilation time:     10189 ms
...linking time:         60 ms
...output file size:     37888 bytes
>> profiler/report/time


Function                       Count      Elapsed Time         % 
of ET

------------------------------------------------------------------------

compile                        1          0:00:10.249          100.0

comp-dialect                   205        0:00:09.659          94.24

fetch-expression               7505       0:00:09.628          93.94

comp-word                      5668       0:00:08.209          80.09

fetch-into                     427        0:00:07.519          73.36

comp-assignment                597        0:00:07.049          68.77

run                            3          0:00:06.492          63.34

comp-context                   21         0:00:06.398          62.42

comp-with                      1          0:00:05.565          54.29

comp-expression                3172       0:00:04.479          43.70

ns-find-with                   24277      0:00:03.962          38.65

finalize                       1          0:00:03.327          32.46

comp-natives                   1          0:00:03.274          31.94

comp-func-body                 180        0:00:03.271          31.91

comp-call                      2775       0:00:02.732          26.65

comp-func-args                 2861       0:00:01.862          18.16

find-aliased                   9650       0:00:01.86           18.14

resolve-type                   8032       0:00:01.799          17.55

get-type                       10758      0:00:01.546          15.08

ns-prefix                      21765      0:00:01.518          14.81

check-enum-symbol              7509       0:00:01.241          12.10

comp-block                     283        0:00:01.05           10.24

comp-variable-assign           417        0:00:01.034          10.08

Also, you won't find the source code of block literals in text format 
if you scan the binary, because they are stored as code and not data. 
That is the only way currently they can be stored in compiled binaries. 
Storing them as text would need a way to load them and then compile 
them at runtime (it will be possible in the future, but not right 
now).


Anyway, the probably best way to store all those series literals 
is to allow the use of a redbin format. We will have that too at 
some point.

OK, this is the long version:

tail-func: func [
    {

  Define a recursive user function with the supplied SPEC and BODY.
     	The function can use a special TAIL-CALL local function
     	to perform a tail-recursive function call.
    }
    [catch]


 spec [block!] {Help string (opt) followed by arg words (and opt type 
 and string)}
    body [block!] {The body block of the function}
    /local the-function tail-call context-word
] [
	; define a new 'tail-call local variable
	tail-call: use [tail-call] ['tail-call]
	
	; bind the given BODY to "know" the 'tail-call variable
	body: bind/copy body tail-call
	
	; find a local word in SPEC
	context-word: find spec word!
	if context-word [context-word: first context-word]
	
	; define the TAIL-CALL function
	set tail-call func spec compose [
		(
			either context-word [
				; set parameters to the new arguments
				compose [set parameters values? (context-word)]
			] [[]]
		)
		throw/name none 'tail-call
	]
	
	; define the function
	the-function: throw-on-error [
		func spec compose/deep [
			(either context-word [context-word] [[]])
			while [true] [
				catch/name [
					return do [(body)]
				] 'tail-call
			]
		]
	]
	
	if context-word [
		; get the function context
		context-word: bind? first second :the-function
		
		; replace the context word in the function body by NONE
		change second :the-function none

		; adjust the TAIL-CALL body
		; replace the 'parameters word

  change/only at second get tail-call 2 bind first context-word context-word
	]

    :the-function
]

values?: func ['word] [second bind? word]

I think I included all your modifications Ladislav but shortly :-)

rfunc: [spec body /local args][
	args: to-block form first (

  do second func spec compose [bind? (to-lit-word first find spec word!)]
	)
	funct spec compose/deep [
		recur: func spec [
				throw/name reduce [(args)] 'recur
		]
		forever [
		   set [(args)] catch/name [
			  return do [(body)]
		   ] 'recur
		]
	]
]

Should do the trick:

rfunc: [spec body /local args][
	args: to-block form first do second 
		func spec compose [bind? (to-lit-word first find spec word!)]
	funct spec compose/deep [

  recur: quote (func spec compose/deep [throw/name reduce [(args)] 
  'recur])
		forever [
		   set [(args)] catch/name [return do [(body)]] 'recur
		]
	]
]

Last version.

- Any spec accepted but needs at least one parameter (can be just 
a local)

rfunc: func [
    [catch]
    spec [block!] body [block!] /local arg obj recur
][
    throw-on-error [

        if error? try [arg: to-lit-word first find spec any-word!][
            make error! "rfunc needs at least one parameter."
        ]
        recur: func spec compose [throw/name bind? (:arg) 'recur]
        obj: catch/name [do second :recur] 'recur
        funct spec compose/deep [
            recur: quote (:recur)
            forever [

                set/any [(to-block form first obj)] second catch/name [
                    return do [(body)]
                ] 'recur
            ]
        ]
    ]
]

split-path: func [

 "Returns a block containing a path and target, by splitting a filespec."
	filespec [any-string!]
	/local target
][
	either any [
		; It's a url ending with a slash. This doesn't account for
		; formed URLs. To do that, we would have to search for "://"
		all [slash = last filespec]
		all [url? filespec  slash = last filespec]
		; Only one slash, and it's at the tail.
		all [target: find/tail filespec slash  tail? target]
	][
		reduce [copy filespec  copy %""]
	][
		target: tail filespec
		if slash = last target [decr target]
		target: any [find/reverse/tail target slash  filespec]
		reduce [copy/part filespec target  to file! target]
	]
]

rebol[
	Author: "Romano Paolo Tenca"
	Date: 10/02/2005
]
split-path-3: func [

 "Splits a file or URL pos. Returns a block containing path and target."
    target [file! url!]
	/local dir pos
][
	parse/all target [
		[#"/" | 1 2 #"." opt #"/"] end (dir: dirize target) |
		pos: any [thru #"/" [end | pos:]] (

   all [empty? dir: copy/part target at target index? pos dir: %./]
			all [find [%. %..] pos: to file! pos insert tail pos #"/"]
		)
	]
	reduce [dir pos]
]

switch: func [
    "Selects a choice and evaluates the block that follows it."
    [ throw ]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /all "Evaluate all matches (not just first one)"
][
    if system/words/all [
        cases: find cases value
        cases: find next cases block!
    ] [
        case: clear [ ]
        append case first cases
        cases: next cases
        while [
            system/words/all [
                all
                cases: find cases value
                cases: find next cases block!
            ]
        ] [
            append case first cases
            cases: next cases
        ]
    ]
    do case
]

switch: func [
    "Selects a choice and evaluates the block that follows it."
    [ throw ]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /all "Evaluate all matches (not just first one)"
][
    while [
        system/words/all [

            any [head? cases all] ; only continue if at the beginning or /ALL 
            was specified
            cases: find cases value
            cases: find next cases block!
        ]
    ] [

     if any [default none? case][default: none case: clear []] ; only 
     clear case the first time
        append case first cases
        cases: next cases
    ]
    do case
]

multi-switch: func [
    "Finds a choice and evaluates what follows it."
    [throw]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /multi "evaluates what follows all matching choices"
][
    either multi [
        while [all [not none? cases not tail? next cases]][
            cases: find cases value 
            either not none? cases [ 
                do first cases: at cases 2
            ][
                either default [do case][none]  
            ]
        ]     
    ][
        either value: select cases value [do value][
            either default [do case][none]
        ]
    ]
]

switch: func [
    "Finds a choice and evaluates what follows it."
    [throw]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /multi "evaluates what follows all matching choices"
][
    cases: find cases value
    if multi [
        multi: copy []
        while [all [not none? cases not tail? next cases]][
            if not none? cases [
                append multi first cases: find cases block! 
                cases: find cases value
            ]
        ] 
    ]
    either not none? multi [
        if not empty? multi [do multi]
    ][

        either cases [do first find cases block!][either default [do case][none]]
    ]
]

switch: func [
    "Finds a choice and evaluates what follows it."
    [throw]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /multi "evaluates what follows all matching choices"
][
    cases: find cases value
    either multi [
        multi: copy []
        while [all [not none? cases not tail? next cases]][
            if not none? cases [
                append multi first cases: find cases block! 
                cases: find cases value
            ]
        ] 
        either not empty? multi [do multi][if default [do case]]
    ][

        either cases [do first find cases block!][if default [do case]] 
    ]
]

With some help from Carl, I got to this:

switch: func [
    "Selects a choice and evaluates the block that follows it."
    [ throw ]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    /all "Evaluate all matches (not just first one)."

    /local code found?
][
    code: clear [ ]
    while [cases: find cases value] [
        either cases: find next cases block! [
            found?: yes
            append code first cases
            cases: next cases
            unless all [break]
        ] [break]
    ]
    do either found? [code] [case]
]

switch: func [
    "Finds all choices and evaluates what follows each."
    [throw]
    value "Value to search for."
    cases [block!] "Block of cases to search."
    /default case "Default case if no others are found."
    
][  
    default: copy []
    while [cases][
        if cases: find cases value [
            append default first cases: find cases block! 
        ]
    ]
    if not empty? default [case: default]
    do case    
]

I've searched RAMBO about a WAIT inconsistency : the dictionnary 
says that "If the value is a DATE/TIME, wait until that DATE/TIME", 
but date! are not accepted as argument (both directly or in a block). 
If this a known bug? I can't find it in RAMBO.

excelent - it does not return error, block is sorted, now I have 
to find out, what it did with record, which is missing field agains 
which I did compare ....

I've not needed a stack so far in REBOL.

In other languages, I usually find myself writing a complete thing 
like Robert has mentioed.

The full works in REBOL would look something like:
  stack/create "xxx"     -- create a new stack called "xxx"
  stack/push "xxx" item  -- push item 
  stack/pop "xxx" item   -- pop item
  stack/peek "xxx"       -- return top item without popping it
  stack/length? "xxx"    -- how many items
  stack/clear "xxx"      -- remove all entries

  stack/discard "xxx"    -- remove all entries and delete the stack

  stack/save "xxx" %file -- write it to a file (may not always be possible)
  stack/read "xxx" %file -- reset to contents of the file

  stack/probe "xxx"      -- return a block of all entries (for debugging)


And, as a stack has  a unique name, an application can be using more 
than one at once.

Ammon. On your point 3 above. "If the word exists in that context 
then it is set there, if not then it grabs that context's parent 
until it has made it to the global or top level."  No, it doesn't 
work this way. There does not need to be runtime searching.

It is more like this...

Look at my nested context example, and focus just on the 'name words.

(1) When the first context function is encounted during evaluation, 
it has a single argument a block - which happens to contain 5 values. 
A set-word, a string, a set-word a word and a block.

(2) Now when this first context function is evaluated it creates 
a new context, and binds to this context the all 'name words it can 
find in the block and nested blocks. To visualise this imagine all 
the 'name words including within the nested blocks have just changed 
Red.

(3) After this colouring of the words, the block is evaluated (as 
in DO) so that at some point the second reference to the Context 
function is evaluated.

(4) Like the first, it colours the name words in its block and nested 
blocks - let's say to green.
(5) The final level is blue of course.

(6) By the time all evaluation is finished the 'name words have the 
appropriate bindings (colours). Conceptually, maybe even actually, 
the innermost 'name word has had its binding (colour) changed three 
times, the second level one twice, and the highest once.


In this way there does not need to be any runtime searching for "parent" 
contexts, because the words themselves maintain the references to 
the appropriate contexts. The Set function does not need to search 
it can see the binding (colour) already.

block: [ "a:" "string1" "b:" "string2"    ]

Fremowe: func [x y][return remove remove find x  y ]

Fremowe block "a:"

Q1:
use [x] [
    x: block
    while [x: find x none!] [change x copy ""]
]

well, it works in a following way - find/match blk ["Petr Krenzelok" 
"Richard Smolak"] - will return block in "Ladislav Mecir" element 
position ...

find-deep: func [b [block!] o [any-type!]][
	forall b [

  either block? b/1 [return find-deep b/1 o][if b/1 = o [return b]]
	]
	none
]
z: find-deep [a b [c d [e] f]] 'e
probe z


Has somebody an idea why this is not working ? Find-deep is always 
return none, even though it finds the e in the inner block. Upon 
debugging the 'e is found and the inner block returned, but then 
one level up in the recursion only a none reaches the 'return after 
the find-deep invocation. Maybe I'm missing something very simple 
?

Rebol []

comment [
	; example usage:
	kernel: load/library %kernel32.dll

 routine-call kernel "MulDiv" [int] [3 [integer!] 2 [integer!] 1 [integer!]] 
 ; == 6
]

routine-call: func [
	library [library!]
	routine-name [string!]
	return-spec [block!]
	arguments [block!] 

 /typed {Arguments is block structure is: [argument-value [datatype] 
 ...]}
	/local routine spec call argument type typed-rule
] [
	spec: make block! length? arguments
	call: make block! (length? arguments) / 2 + 1
	insert call [return routine]
	typed-rule: copy []
	if typed [typed-rule: [set type skip]]
	parse reduce arguments [
		any [
			set argument skip
			typed-rule
			(
				insert/only tail spec 'argument
				insert/only tail spec either typed [
					type
				][
					reduce [type?/word get/any 'argument]
				]
				insert/only tail call get/any 'argument
			)
		]
	]
	insert tail spec [return:]
	insert/only tail spec return-spec
	routine: make routine! spec library routine-name
	do call
]

use [libc zero-char as-rebol-string malloc][
	libc: load/library %/usr/lib/libc.dylib ; osx variable

	zero-char: #"^@"

	as-rebol-string: func [
		[catch]
		s [string!] 
		/local pos
	][

  unless pos: find s zero-char [throw make error! "s is not a c-string"]
		s: head remove/part pos tail s
		replace/all s "\n" newline
		replace/all s "\t" tab
	]
	
	malloc: func [
        size [integer!] "size in bytes"
    ][
        head insert/dup copy {} zero-char size
    ]

	sprintf: func [
		spec {block structure is: [format values ...]}
		/local s
	][
		s: malloc 4096
		insert/only head spec 's
		routine-call libc "sprintf" [int] spec
		as-rebol-string s
	]
	
	printf: func [
		spec {block structure is: [format values ...]}
	][
		print sprintf spec
	]
]

I need to "filter" the content of an object. Any better idea on how 
to do it other the this one:
obj: make object! [
	bb: 1
	cc: 4
	dd: 7
]


block: [bb dd]

filter: func [obj block /local newobj][
	newobj: make object! []
	foreach [s v] third obj [
		if find block to-word s [
			newobj: make newobj reduce [
				s v
			]	
		]
	]
	newobj
]

probe filter obj block

Result:

make object! [
    bb: 1
    dd: 7
]

if the solution gregg posts is better, use that, but:

a: make object! [
  bb: 1
  cc: 4
  dd: 7
]

block: [bb dd]


make object! foreach word difference first a block [head remove remove 
find third a to-set-word word]

d: third a

make object! foreach word next difference first a block [head remove 
remove find d to-set-word word]

seems to work

the point is, I need the position to copy it into. The position is 
automatically and elegantly referenced by Y and can be a lengthy 
calculation, if I need to find it again, but I may need to do that 
or make some other position marker which contains the block that 
holds the object I need to change.

then I have a function that asks for a specific relation by diving 
down a path with a block like: [customers 1234 invoices 45 articles 
15] to find customer 1234 who has invoice 45 which holds article 
15

then there is a function to add and remove relations

(also, you might find ways to structure your data in REBOL which 
reduce the number of block...like make them into structured objects 
... just a wild guess, maybe that would compact it more?)

make-template-context: func [
	template
	/local words spec
][
	words: remove-each val to-block template [tag? val]

	spec: words
	forall spec [spec/1: to-set-word spec/1]
	append spec none

	context spec	
]

eval-template: func [
	template-ctx
	code
	/local err
][

 unset bind next first template-ctx template-ctx  ; unset all words 
 in the context
	do bind code template-ctx  ; do the code

	; Check if any tags were not set

 if find next second template-ctx unset! [ ; were any tags not set 
 ?
		print "Some tags were not set!"
		foreach word next first template-ctx [
			if not value? in template-ctx word [
				print [word "is unset!"]
			]
		]
	]
]

; now test


template: "<html><head><title> title </title></head><body>tag1 tag2 
tag3</body></html>"

template-context: make-template-context template

eval-tags: [
	title: "web page"
	tag1: "tag1"
	tag2: "tag2"
	tag3: "tag3"
]


eval-template template-context eval-tags  ; <- this sets all expected 
tags and is ok

eval-template template-context [] ; <- this doesn't set any tags 
so will complain and show all unset tags

Paths are structures like blocks. Find doesn't do structure analysis 
on block types like that - it just tries to determine if the exact 
same path is there, not another that resembles it.

Here's a different approach to get the result I'm after:

cast: make function! [
	block [block!] "Block to cast"
	words [block!] "Words to convert into literal words"
	/local blk word
	"Casts nominated words within a block into literal words."
] [
	blk: copy []
	repeat i length? block [

  insert/only tail blk either find words pick block i [to lit-word! 
  pick block i] [pick block i]
	]
	blk
]

>> cast [area red button green 'btn blue] [area button]
== ['area red 'button green 'btn blue]
>> reduce cast [area red button green 'btn blue] [area button]
== [area 255.0.0 button 0.255.0 btn 0.0.255]

rel-obj: make object! []

add-relation: func [path-block [block!] /local p v w] [
  p: to-block 'rel-obj
  parse path-block [
    any [
      [set w word! (
        unless all [

          find either object? do to-path p [first do to-path p][[]] w
          insert tail p w
        ] [

          do load mold reduce [to set-path! p make do to-path p reduce [to-set-word 
          w none]]
        ]
      ]
   ]
]

I'm not sure it's enough...

That's a nice idea, though there are some technical CSS issues......For 
example, the actual script is displayed in a <pre> block. That means 
images may not float where you'd expect them. It'll take some experimentation 
to find the best way to do it.

Maybe I'll find "a little spare time" to do a field which draws it's 
text in the effect block and rewrite the stilll somewhat buggy text 
editing functions ;-)

(Not a serious comment though, because that's definitly not the league 
I'm playing in.)

From the previous discussion I got the impression, that everything 
is words, when they're typed in, or viewed as output. My reasoning 
goes as: if NONE is a word when inside a block (initally without 
specifying, what we do with that block), then everything inside a 
block must be words (initially). Then the input parser take that 
block and figure out, what's inside. Some of the stuff inside ende 
up as other datatypes (in this case integer!), others are left as 
words. Or?

What I find a bit peculiar is, that things like [integer! none +] 
are left as words and not being parsed to the expected datatypes.

re: comments in 'core' on the plague of MI ...

multiple inheritance works rather nicely in Curl since you are required 
to provide 'secondary'  constructors - I prefer prototype-based with 
an option for class hierarchies, personally ( try experimenting with 
Logtalk if you can find time ).  I am watching Io, the language, 
evolve as Rebol3 emerges: what is interesting to me is that I ask 
'But is that Oz ?' in Oz. ( which is multi-paradigm )  I used to 
hear a lot of 'getting it' about Prolog and Smalltalk.  After almost 
2 decades in both, I think many of them "didn't get it" ( class hierarchy 
obsessed, as ST purists are/were ).  Ruby is so much like Smalltalk 
that I am quite enjoying watching Groovy play catch-up with Ruby 

Most issues in Rebol have a parallel in Javascript; where ( for the 
neophyte) experiments with 
	typeof

in a console is about the only way for the average developer  to 
'get  it' given
	d1 = Date  // now you use d1 as a function d1()
	d2 = Date()   // d2 is a string that looks like a number   

 d3 = new Date() // d3 is an object but it is UTC but it is presented 
 local time but it is compared UTC .... 
or
	s1 = "string"
	s2 = String("string")
	s3 = new String('string')

 s3[1] = 6   // s3 is an object, as typeof of reveals; String 'equality' 
 in JavaScript even with === is no end of grief  and  for what convenience 
 ?
	s3["size"] = 6
or
	a1 = Array(42)
	a2 = new Array(42)

I think the latter 2 show just how rushed LiveScript was pushed/forced 
out to market as "LavaScript" before the Sun "StrongTalk" folks had 
much influence on the Netscape folks ....  Rebol3 is in better hands 
than 'ActionScrtpt'  as it drifts into classes - because it is being 
kept 'in hand''

The changes in Groovy as it complied with the JSR for Java scripting 
are interesting ( Groovy is almost neat as Rebol would be if it were 
confined to, say, living on  top of VisualBasic ;-)  Now to avoid 
'Rebol on Rails' ...

I think some people who adopted Spring to cope with Java would appreciate 
Rebol ( there, too, you have to 'get it ' )

 MySubClassObject.prototype = new MyParentClassObject()   // now go 
 mess with THAT object before it is useful ...
	// ...

 MySubClassObject.prototype.superclass = MyParentClass  // to fake 
 having a superclass other than Object
cannot be much easier to "get" than anything about Rebol
	use    ; now mostly use /local
and

 bind   ; modifies the block it is passed; use COPY refinement to 
 preclude this side-effect

Smalltalk80 was like "Rebol4" as compared to the first passes at 
an O-O language ...  someone who actually understands Smalltalk contexts/blocks 
and JavaScript should 'get it' with Rebol ( some of those people 
are using Seaside with Squeak, Dolphin and/or VisualWorks ST )

  my 2 cents:  a1 should have been an array of fixed size and only 
  a2 should be a Vector object

; I did a dif between the functions in VIEW and those in CORE for 
a default install.  What I get is this ( I hope it is useful to have 
al 106  in one place )

 alert  brightness?  caret-to-offset  center-face  choose  clear-face 
  clear-fields  confine  crypt-strength?

 dbug  deflag-face  desktop  dh-compute-key  dh-generate-key  dh-make-key 
  do-events  do-face  do-face-alt  do-thru  

 draw  dsa-generate-key  dsa-make-key  dsa-make-signature  dsa-verify-signature 
  dump-face  dump-pane  edge-size?  

 editor  emailer  exists-thru?  find-key-face  find-window  flag-face 
  flag-face?  flash  focus  get-face  

 get-net-info  get-style  hide  hide-popup  hilight-all  hilight-text 
  hsv-to-rgb  in-window?  inform  

 insert-event-func  inside?  install  launch-thru  layout  link-relative-path 
  load-image  load-stock  

 load-stock-block  load-thru  local-request-file  make-face  notify 
  offset-to-caret  open-events  outside?  

 overlap?  path-thru  read-net  read-thru  remove-event-func  request 
  request-color  request-date  request-dir  

 request-download  request-file  request-list  request-pass  request-text 
  reset-face  resize-face  rgb-to-hsv  

 rsa-encrypt  rsa-generate-key  rsa-make-key  screen-offset?  scroll-drag 
  scroll-face  scroll-para  set-face  

 set-font  set-para  set-style  set-user  show  show-popup  size-text 
  span?  stylize  textinfo  unfocus  

 uninstall  unlight-text  unview  vbug  view  viewed?  win-offset? 
  within?

...in reference to his code block:


 search: func [ from whatis /reverse /case /local list x y p temp 
 sfind start end step ] [
         list: buffer/lines
         sfind: to-path join [find] [

            either case ['case]['only] either reverse ['reverse]['only]
            ]
         y: from/y
         set [start end step] reduce any [

            all [ reverse [(y - 1) 1 -1] ] [(y + 1) (length? list) 1]
            ]
         temp: at pick list y (from/x + either reverse [-1][1])
         return if p: catch [

            if x: sfind temp whatis [ throw reduce [ index? x y ] ]
            for y start end step [

               temp: either reverse [ tail pick list y ] [ pick list y ]

               if x: sfind temp whatis [ throw reduce [ index? x y ] ]
               ]
            ] [ to-pair p ]
         ]

I have another question about parse, if I may.. I am trying to make 
a parse block that will uppercase all letters after the . ! or ? 
. I did it just for dots, but I can't make it for all 3  ( one alternative 
is to call parse 3 times each time with different separator char. 
The problem can be observed here, and happens because [ A | B | C 
] pattern first looks for A and if it doesn't find a checks B , which 
means it will skip B if A is after B. Is there any way to say "use 
any of those chars - *whichever comes first" ? .. example where you 
can see the  problem:

Hi, thanks very much for the fast replies. 

I have read the parse-tutorial and it seems very good for understanding 
how to create rules that will match patterns, however I only found 
one brief section that described using "copy" to extract the data 
from the line, rather than just confirming that a match was found 
(or not). I tried to use the copy examples but evey time I modified 
them I ended up with errors as I don't really understand how they 
work.


Peter, thanks for your example, it does almost what I want but the 
result in 'extract' does not contain the part of the string matched 
by "wanted". In my simple example I could just append the word "wanted", 
but in a real world case I would be using a patern match to find 
the "wanted" key word.


I also want to develop the code further to search for a different 
set of matches if the first set is found, in your example I am unclear 
where the block is that is performed if the string is found.  

Thanks very much for your help. /\/\

uh, was on slow connection, so my reply got lost. Mhinson - there 
is no symbolic way to represent beginning of the line. I don't know 
any in any system. The only thing I know is end-of-line (newline). 
I know what you probably mean - you want to identify beginning of 
your lines, but even for first line (so not a rule, matching newline 
first, then next char = beginning of line). But - there is still 
various ways of how to do it. First - I think that your config files 
are chaos. Do they have any rules for some sections at all? :-) I 
also like what sqlab mentioned - sometimes it is easier to break 
stuff into 2 pass strategy. Read/lines is your friend here. You can 
try it on text files and you'll see, that the result is going to 
be a block of lines. I usually do:

data: read/lines %my-data-file.txt

;--- remove empty lines from block of lines ...
remove-each line data [empty? trim copy line]

foreach line data [do something with data ....]


Simply put - if rules for parser are out of my scope of capabilities 
(which happens easily with me :-), I try to find my other way around 
...

I have been studying the code from sqlab but I cant understand it 
enough to modify it. This is a deconstruction of part of it with 
my comments added. I would love a hand to understand this a bit more. 
 I cant find any documentation for this sort of thing that I can 
understand. 

I have also been trying to retrieve an index number when reading 
lines so it can be used as suggested by Sunanda. drawn a blank so 
far.



parse/all lines [                ;; parse the whole block called 
lines /all makes parsing only use values given below 

                                            ;; I am not sure if this is itteratied or the whole block parsed 
                                            as one. 
	(wanted: copy [])  ;; initalise wanted 

 | some [                 ;; one or more matches needed to return 
 true

  ifa: "interface"  some [   ;; ifa is given a string value right in 
  the middle of the parsing code

                                            ;; I see why, but not how this is able to slip into the middle here

                                            ;; then some starts another block so perhaps the "interface" is used 
                                            by parse too??

   ife: "point-to-point"  break  ;; no idea how the syntax works here
			| ife: newline    break           ;; or here

   | skip                                      ;; this skips I think 
   till one of the OR conditions are met from below?
		]

  (append/only  append wanted copy/part ifa ife   interf:  copy []) 
    ;;  I dont understand what block append/only is working on here

                                                                                                                                           ;;  append to block wanted using a part copy between ifa & ife but 
                                                                                                                                           I 

                                                                                                                                           ;;  dont understand the source for the copy 

  | some [                                                     ;; I 
  think perhaps all the below rules are end or search paterns?   
			s: " interface" (interf: copy [])
	        | drule
	        | iprule
	        | norule
	        | pvcrul
	        | pprule
	        | !rule
	        | break 
		] thru newline           ;; final catchall end search pattern. 
	]
]


Sorry to ask so many questions, feel free to throw me out if this 
is just too much, but I have spent several hours on this fragment 
allready. Thanks.

Thanks Paul, I fear I have been ignoring the use of other things 
like find. I guess with more complex parse expressions find may be 
a shortcut to extract a substring from a predictable block of text..

REBOL []

do %include.r
include %file-list.r


flash-wnd: flash "Finding test files..."

if file: request-file/only [
    files: read first split-path file
]
if none? file [halt]

items: collect/only item [
    foreach file files [item: reduce [file none]]
]

unview/only flash-wnd



;-------------------------------------------------------------------------------
;-- Generic functions

call*: func [cmd] [
    either find first :call /show [call/show cmd] [call cmd]
]

change-each: func [
    [throw]

    "Change each value in the series by applying a function to it"

    'word   [word!] "Word or block of words to set each time (will be 
    local)"
    series  [series!] "The series to traverse"

    body    [block!] "Block to evaluate. Return value to change current 
    item to."
    /local do-body
][
    do-body: func reduce [[throw] word] body
    forall series [change/only series do-body series/1]

    ; The newer FORALL doesn't return the series at the tail like the 
    old one

    ; did, but it will return the result of the block, which is CHANGE's 
    result,
    ; so we need to explicitly return the series here.
    series
]

collect: func [
    "Collects block evaluations." [throw]
    'word
    block [block!] "Block to evaluate."
    /into dest [block!] "Where to append results"
    /only "Insert series results as series"

    /local fn code marker at-marker? marker* mark replace-marker rules
][
    block: copy/deep block
    dest: any [dest make block! []]

    fn: func [val] compose [(pick [insert insert/only] not only) tail 
    dest get/any 'val

        get/any 'val
    ]
    code: 'fn
    marker: to set-word! word
    at-marker?: does [mark/1 = marker]
    replace-marker: does [change/part mark code 1]
    marker*: [mark: set-word! (if at-marker? [replace-marker])]
    parse block rules: [any [marker* | into rules | skip]]
    do block
    head :dest
]

edit-file: func [file] [
    ;print mold file

    call* join "notepad.exe " to-local-file file ;join test-file-dir 
    file
]

flatten: func [block [any-block!]][
    parse block [

        any [block: any-block! (change/part block first block 1) :block | 
        skip]
    ]
    head block
]

logic-to-words: func [block] [

    change-each val block [either logic? val [to word! form val] [:val]]
]

standardize: func [

    "Make sure a block contains standard key-value pairs, using a template 
    block"
    block    [block!] "Block to standardize"
    template [block!] "Key value template pairs"
][
    foreach [key val] template [
        if not found? find/skip block key 2 [
            repend block [key val]
        ]
    ]
]

tally: func [

    "Counts values in the series; returns a block of [value count] sub-blocks."
    series [series!]
    /local result blk
][
    result: make block! length? unique series

    foreach value unique series [repend result [value reduce [value 0]]]
    foreach value series [
        blk: first next find/skip result value 2
        blk/2: blk/2 + 1
    ]
    extract next result 2
]


;-------------------------------------------------------------------------------

counts: none

refresh: has [i] [
    reset-counts
    i: 0
    foreach item items [
        i: i + 1
        set-status reform ["Testing" mold item/1]
        item/2: random/only reduce [true false]
        show main-lst
        set-face f-prog i / length? items
        wait .25
    ]
    update-counts
    set-status mold counts
]

reset-counts: does [counts: copy [total 0 passed 0 failed 0]]

set-status: func [value] [set-face status form value]

update-counts: has [pass-fail] [
    counts/total: length? items

    pass-fail: logic-to-words flatten tally collect res [foreach item 
    items [res: item/2]]
    ;result (e.g.): [true 2012 false 232]
    standardize pass-fail [true 0 false 0]
    counts/passed: pass-fail/true
    counts/failed: pass-fail/false
]

;---------------------------------------------------------------


main-lst: sld: ; The list and slider faces
c-1:           ; A face we use for some sizing calculations
    none
ml-cnt:        ; Used to track the result list slider value.
visible-rows:  ; How many result items are visible at one time.
    0

lay: layout [
    origin 5x5
    space 1x0
    across

    style col-hdr text 100 center black mint - 20

    text 600 navy bold {

        This is a sample using file-list and updating progress as files are
        processed. 
    }
    return
    pad 0x10

    col-hdr "Result"  col-hdr 400 "File" col-hdr 100
    return
    pad -2x0

    ; The first block for a LIST specifies the sub-layout of a "row",

    ; which can be any valid layout, not just a simple "line" of data.

    ; The SUPPLY block for a list is the code that gets called to display

    ; data, in this case as the list is scrolled. Here COUNT tells us

    ; which ~visible~ row data is being requested for. We add that to 
    the

    ; offset (ML-CNT) set as the slider is moved. INDEX tells us which
    ; ~face~ in the sub-layout the data is going to.

    ; COUNT is defined in the list style itself, as a local variable 
    in
    ; the 'pane function.
    main-lst: list 607x300 [
        across space 1x0 origin 0x0
        style cell text 100x20 black mint + 25 center middle
        c-1: cell  cell 400 left   cell [edit-file item/1]
    ] supply [
        count: count + ml-cnt
        item: pick items count
        face/text: either item [
            switch index [
                1 [

                    face/color: switch item/2 reduce [none [gray] false [red] true [green]]
                    item/2
                ]
                2 [mold item/1]
                3 ["Edit"]
            ]
        ] [none]
    ]

    sld: scroller 16x298 [ ; use SLIDER for older versions of View

        if ml-cnt <> (val: to-integer value * subtract length? items visible-rows) 
        [
            ml-cnt: val
            show main-lst
        ]
    ]
    return
    pad 0x20
    f-prog: progress 600x16
    return
    status: text 500 return
    button 200 "Run" [refresh  show lay]
    pad 200
    button "Quit" #"^q" [quit]
]

visible-rows: to integer! (main-lst/size/y / c-1/size/y)

either visible-rows >= length? items [
    sld/step: 0
    sld/redrag 1
][
    sld/step: 1 / ((length? items) - visible-rows)
    sld/redrag (max 1 visible-rows) / length? items
]

view lay

Hi, I am trying to reduce the number of global variables I use in 
functions & so my functions return blocks, but I have not discovered 
any simple way to dereference the information in the variables, within 
the blocks..  I have written a function to do it, but I guess there 
is a built in function if I could find it. Or at least something 
a bit more elegant than this: "return_value_of_block_component" function. 
  Any tips most welcome please.

f1: func [a] [
	b: join a "-Bee"
	c: join a "-Cee"
	return [b c]
]

d: f1 {Hi}

return_value_of_block_component: func [block component] [
	foreach element block [
	if element = component [return reduce [element]]
	]
]

H: return_value_of_block_component d 'b
I: return_value_of_block_component d 'c

print H
print I

If you want variable records you either put the data in an inner 
block (as you have), or use a distinct datatype for the keys ans 
search for values of that datatype to find the next key.

Hi, is there any clever Rebol way to access the Tuples in this block 
by the associated numbers 80 & 4 please?
b: [80["8.8.8.8" "random"] 4["4.4.4.4"]]


if they were words it would be easy, but with numbers I am wondering 
if I just have to search for them & find the index & add one? Or 
perhaps convert the numbers into words by prepending them with a 
letter perhaps? Thanks.

One can say that FIND limits its input to series! to eliminate errors 
as early as possible. Imagine if FIND accepted NONE and we had some 
intricate series of FINDs on a single block 'a:

find find find/reverse find a 'e string! 'f integer!
== none


If 'a is a dynamic block (not known when you write the code) where 
is the error?


It's not a great example, but it raises the question of how forgiving 
you want your functions to be, when you write them. I consider that 
you generally want to catch errors as early as possible, to avoid 
having to write "forgiving" code that can take up space and complicate 
things and worst of all, make the code much harder to debug. But 
it's only one school of thought.

Hello - hope someone can find the newbie mistake I'm making here. 
 Wanted to use REBOL to tackle a need to get data from Salesforce 
using their SOAP API.  New to SOAP, WSDL and Salesforce, but using 
SoapUI mananged to do this POST (edited only to hide personal info):

POST https://login.salesforce.com/services/Soap/u/19.0HTTP/1.1
Accept-Encoding: gzip,deflate
Content-Type: text/xml;charset=UTF-8
SOAPAction: ""
User-Agent: Jakarta Commons-HttpClient/3.1
Host: login.salesforce.com
Content-Length: 525


<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:urn="urn:partner.soap.sforce.com">
   <soapenv:Header>
      <urn:CallOptions>
         <urn:client></urn:client>
         <urn:defaultNamespace></urn:defaultNamespace>
      </urn:CallOptions>
   </soapenv:Header>
   <soapenv:Body>
      <urn:login>
         <urn:username>[jort-:-xxxxxxxxxxxxx-:-com]</urn:username>

         <urn:password>xxxxxxxxxx78l6g7iFac5uaviDnJLFxxxxx</urn:password>
      </urn:login>
   </soapenv:Body>
</soapenv:Envelope>

and get the desired response:

HTTP/1.1 200 OK
Server: 
Content-Encoding: gzip
Content-Type: text/xml; charset=utf-8
Content-Length: 736
Date: Fri, 02 Jul 2010 20:32:14 GMT


<?xml version="1.0" encoding="UTF-8"?><soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"
xmlns="urn:partner.soap.sforce.com" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"><soapenv:Body><loginResponse> 
......

Then using SoapUI I am able to send a successful Logout message.


Using REBOL 2.7.7.3.1, I created an "upload" string containing the 
POST block above without the "POST " at the beginning, set my url 
to:

>> url
== https://login.salesforce.com/services/Soap/u/19.0

and tried this:

>> response: read/custom url reduce ['POST upload]

but consistently get a Server 500 error:


** User Error: Error.  Target url: https://login.salesforce.com:443/services/Soap/u/19.0 
could not be retrieved.  Se
rver response: HTTP...
** Near: response: read/custom url reduce ['POST upload]

For completeness, here's the upload value:

>> print mold upload
{https://login.salesforce.com/services/Soap/u/19.0HTTP/1.1
Accept-Encoding: gzip,deflate
Content-Type: text/xml;charset=UTF-8
SOAPAction: ""
User-Agent: Jakarta Commons-HttpClient/3.1
Host: login.salesforce.com
Content-Length: 525


<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:urn="urn:partner.soap.sforce.com">

   <soapenv:Header>
      <urn:CallOptions>
         <urn:client></urn:client>
         <urn:defaultNamespace></urn:defaultNamespace>
      </urn:CallOptions>
   </soapenv:Header>
   <soapenv:Body>
      <urn:login>
         <urn:username>[jort-:-researchpoint-:-com]</urn:username>

         <urn:password>metrics12378l6g7iFac5uaviDnJLFVprDl</urn:password>
      </urn:login>
   </soapenv:Body>
</soapenv:Envelope>}

Would appreciate any help you can give!

In R2, you can do this:

1. get the body of the object as a block
2. find the word you want to remove
3. remove the word and its value coming right after
4. make a new object from the block

set 'scan-doc func [str /options block] [
    clear out
    title: none

    if options [
        if find block 'no-title [title: true]
    ]
    emit options opts
    clear opts
    str: join str "^/^/###" ; makes the parse easier
    parse/all detab str rules
    if verbose [
        n: 1
        foreach [word data] out [
            print [word data]
            if (n: n + 1) > 5 [break]
        ]
    ]
    out
]

count-word-frequency: func[
	"Counts word frequency from the given text"
	text [string!] "text to analyse"
	/exclude ex [block!] "words which should not be counted"
	/local counts f wordchars nonwordchars
][
	counts: make hash! 100000

 wordchars: charset [#"a" - #"z" #"A" - #"Z" "�������������̊�؎����ύ�Ѫ�"]
	nonwordchars: complement wordchars
	parse/all text [
		any nonwordchars
		any [
			copy word some wordchars (
				;probe word
				if any [not exclude none? find ex word][
					either none? f: find/tail counts word [
						repend counts [ word 1 ]
					][
						change f (f/1 + 1)
					]
				]
			)
			any nonwordchars
		]
	]
	counts: to-block counts
	sort/skip/compare/reverse counts 2 2
	new-line/skip counts true 2
]

the problem I find with block parsing is the rigid interpretation 
of datatypes.

About your matching from a block proposal, if the CHECK proposal 
gets accepted then I doubt this will - the usage scenarios where 
you can't just use alternates would be too rare, especially given 
how easy CHECK (FIND ...) could do the job in those cases.

Hi Paul,  I may have mis-stated what I'm after.  You see the site 
 http://rebol.com/r3/docs/functions/try.htmlhas displayable rebol 
code and responses within the html.  If you captured the html code 
you would find something like this:
<html>
<head>
...(additional html code and text)...

<title>REBOL 3   Functions: try</title>TRY returns an error value 
if an error happened,
otherwise it returns the normal result of the block.</p>

<pre>if error? try [1 + "x"] [print "Did not work."]             
                    <-- in this e.g. the tag <pre> will preceed the 
rebol command until the next tag

<span class="eval">Did not work.</span></pre>                    
      <-- the tag <span class="eval">  will preceed the response 

<pre>if error? try [load "$10,20,30"] [print "No good"]          
          <-- this is the next rebol command

<span class="eval">No good</span></pre>                          
       <-- this is the next response
<h2 id="section-3">Related</h2>


I want to be able to interrogate the html code, parse it and capture 
the rebol commands and responses (if any), then put that into your 
above block example.

try this: http://box.lebeda.ws/~hmm/rebol/load-first-block.r

but it's not well tested. You can make the chunk size better. It's 
just 200 bytes just to not find the block easily in the first one.

what is your common rebol syntax you use mySQL driver with? I find 
it a bit difficult to use Doc's block mode, as I have to provide 
it with exactly the same amount of question marks, as there is amount 
of columns in the table (talking of insert here)

I have been playing with this for hours and have not made any progress 
after reading everything I could find about ports and ftp. Why does 
the following script not work?

    ftp-port: open [
        scheme: 'ftp 
        host: "ftp.mysite.org" 
        port-id: 21 
        user: "[user-:-mysite-:-org]" 
        pass: "xxxxxxxxxx"
    ] 
    write ftp-port "Test File" 
    close ftp-port

It gives the following error.


** Script Error: write expected destination argument of type: file 
url object block
** Where: func [face value]

1. exactly
2. effectively, but my rule does not work :
 if find ip-em/to "[mymail-:-myserver-:-com]" [op-block/2: "myfolder"]

 Where myfolder is the name of the directory in the file system (not 
 the name of the folder in Readmail)

3. not this window that is REALLY useful, but the window that allows 
you to delete some mails before fetchnig them

rebol [
	date: 24-Jul-2005 
	author: "Anton Rolls"
	comment: {

  Investigating why adding/removing 'merge from effect block seems 
  to change line-width on
		arc, circle etc.:

		ToDo:
		  - try to 

  - It looks like the AGG anti-aliasing is with the default window 
  background color ?

    When MERGE is added, then it's with the actual color that is merged 
    (seems ok and good to me).

    - so try to set b1/color so it's the same as the color anti-aliased 
    against in the merged version

    Perhaps default window background color (200.200.200) is close to 
    the default agg anti-aliasing color ?
		  (do not use custom window color)
		- try a simple LINE
		- report to RAMBO or AGG group
		- submit to RAMBO


  This shows that the addition of 'merge seems to add 0.5... (?) or 
  some scaled factor to the line-width:
	}
]

effect-blk: [
	draw [
		pen black
		line-width 0
		translate 25x25
		scale 1 1 
		circle 0x0 24 ;arc 0x0 24x24 0 270
	]
]
make-2nd-effect: func [/local result][
	result: copy/deep effect-blk
	insert result 'merge

 ;result/draw/line-width: result/draw/line-width - 0.5 ; <- even with 
 this they don't look quite the same

 result/draw/line-width: result/draw/line-width - any [attempt [correction-scr/data 
 * 0.1 + 0.5] 0]
	result
]
refresh: does [
	b2/effect: make-2nd-effect
	show [b1 b2]
	big1/image: to-image b1
	big2/image: to-image b2
	diff/image: xor big1/image big2/image
	same-txt/text: join "same? " big1/image = big2/image
	show [big1 big2 diff same-txt]
]
view/new window: center-face layout compose/only [
	across
	label 80 "scale"
	scroller 200x20 with [data: 1][
		change/dup next find b1/effect/draw 'scale face/data 2
		refresh
	]
	return
	label 80 "line-width"
	scroller 200x20 [
		b1/effect/draw/line-width: face/data * 4
		refresh
	]
	return
	label "line-width correction"
	correction-scr: scroller 200x20 [
		refresh
	]
	return
	b1: box 50x50 [refresh] effect (effect-blk)
	b2: box 50x50 [refresh] effect (make-2nd-effect)
	same-txt: text 200
	return
	big1: image 200x200
	big2: image 200x200
	return
	diff: image 200x200
]
refresh
do-events

funny, in experience, I find it easier in many cases to do a hybrid 
model.  one where you load the string into some block you can then 
more easily parse.  There are many kinds of real-world data which 
is not easily loadable in REBOL and in cases where you must make 
a dialect over some outside data... blocks are rarely useable.

hmm, it is long time ago I looked at Temple sources, but it seemed 
to me, that first phase generates block of blocks ... then you use 
some functions, e.g. find-by-id, etc., which does lookup in rebol 
block structure and then it replaces/adds data to it. Now once you 
generate html content, how does it know about its original formatting? 
You would have to store pointers to certain sections of original 
template to fill-in releavant data, but maybe I just was looking 
wrong into it ...

then you have several functions available, mainly find-by-id, find-by-class, 
find-path (which help you in nesting into parsed block-of-blocks 
structure ....

Yes, I did, and if you scroll a little bit up, you can find the link 
easilly - it's in big yellow block of text:) And I agree, that it 
would be good to have cookies support directly in Rebol, as my cookies-daemon 
is relly hard hack I cannot be sure that it would not rewrite some 
future http protocol updates

thanks ... knowing that the header was not in cause... alllowed me 
to find the true culprit .... some prerebol oditty which wrapped 
my entire code in a block (my fault in how I was using it).

Ashley: just one little fix to make it work with /View 1.2.1:

(in display.r, line 99, word -> :word) if :word [set :word last-face]
else, 'if is confused (can't find then-block)

construct: func [
    block [block!] /with object [object!]
/local nb spec values name value
][
    if not with [object: object!]
    spec: copy []
    values: copy []
    parse/all :block [
        any [
            to set-word! (nb: 0) some [
                set name set-word! (nb: nb + 1 append spec :name)
            ]
            set value skip (

                insert tail values nb insert/only tail values :value
            )
        ]
    ]
    append spec none
    object: make object spec
    foreach [nb value] values [
        loop nb [
            set in object (to-word first spec) 

                either find [true false none on off] :value [do value][:value]
            spec: next spec
        ]
    ]
    object
]

And, I find it simpelst to have the data on the screen and in the 
program in sync. Sorting should alter the data block as well. If 
I pick the first line, I want to pick the first record. Of course 
using an API for indirection is OK too. But than do it always and 
for everything. No direct access to the record data.

hmm, dunno of how to explain it. It simply parses XML, creates block 
of blocks structure. Then you have those functions like find-by-id, 
find-by-name, etc., which you can use to manipulate values ... then, 
once done, you generate XML. What I did not like is, that ti builds 
the structure from the scratch, so e.g. with html page, you loose 
nice formatting, comments etc. But others said, you could have pointers 
from such nodes to original doc and rebuild the doc properly ...

Doing my first steps with REBOL I tried to do something with XML

(reading/eventually modifing/writing). I looked for some scripts 
helping
me to do this and found:

1. xml2rebxml/rebxml2xml:
    I got the following problems:
    - missing/loosing comments
    - missing/loosing elements - that's realy serious
    my steps were:
      my-doc: xml2rebxml read %simple.xml
      write %simple2.xml rebxml2xml my-doc


    The second documents finishes outputting elements after some comment
    block in
     the source xml doc.

 2. xml-parse/xml-object:

     The versions I found on the reb library didn't work, I used some

     older versions from rebXR-1.3.0, I've got my objects, but it would 
     be

     nice to have a third module like xml-write to get the object tree
     back to xml. Is somebody developing something like this?

 3. mt.r:

     I tried to figure out how it works. Basically I can write some XML

     based on a REBOL block but I couldn't figure out how to define the

     rules about elements and attributes. Where can I find an example

     about writing for instance svg with mt.r, how looks the coresponding
     REBOL block and the rules for svg?


Where can I find more about xml and REBOL, I think it would be very 
nice
to have some REBOL scripts, doing things like 
   some-elem: xml-create [ elem "foo" namespace "myns" attribs [
                                     bar "something"
                                     xyz "123"]
                                     ]
   xml-modify [ elem another-elem append some-elem ]
and finally
   xml-write %mynewxml.xml my-doc


Is somebody developing something like this with REBOL? Some scripts 
giving

me the same comfort in REBOL like maybe XOM (http://www.xom.nu) is 
giving
for XML in Java. Of course done with some nice REBOL dialects?

What is the above mentioned "EasyXML" - is it available for use/testing?

Thank you for any tips, carsten

REBOL [
	Title:		"SVG Demo"
	Owner:		"Ashley G. Tr�ter"
	Version:	0.0.1
	Date:		21-Jun-2005
	Purpose:	"Loads and displays a resizeable SVG file."
	History: {
		0.0.1	Initial release
	}
	Notes: {
		Tested on very simple SVG icons
		Only a few basic styles / attributes / commands supported

  Does not handle sizes in units other than pixels (e.g. pt, in, cm, 
  mm, etc)

  SVG path has an optional close command, "z" ... AGG shape equivalent 
  auto-closes

  load-svg function needs to be totally refactored / optimized ... 
  *sample only*
	}
]

;	The following commands are available for path data:
;
;		M = moveto
;		L = lineto
;		H = horizontal lineto
;		V = vertical lineto
;		C = curveto
;		S = smooth curveto
;		Q = quadratic Belzier curve
;		T = smooth quadratic Belzier curveto
;		A = elliptical Arc
;		Z = closepath

;print: none	; comment out this line to enable debug messages

load-svg: function [svg-file [file! string!] size [pair!]] [

 id defs x y to-color to-byte draw-blk append-style svg-size scale-x 
 scale-y
][
	xml: either string? svg-file [parse-xml svg-file] [

  unless %.svg = suffix? svg-file [to error! "File has an invalid suffix!"]
		parse-xml read svg-file
	]

 unless xml/3/1/1 = "svg" [to error! "Could not find SVG header!"]

 ;unless find ["id" "xmlns"] xml/3/1/2/1 [to error! "Could not find 
 ID header!"]

 ;unless xml/3/1/3/1/1 = "defs" [to error! "Could not find DEFS header!"]

	id: xml/3/1/2
	defs: xml/3/1/3


	;
	;	--- Parse SVG id
	;

	svg-size: either find ["32pt" "48pt" "72pt"] select id "width" [
		switch select id "width" [
			"72pt"	[120x120]
			"48pt"	[80x80]
			"32pt"	[60x60]
		]
	][

  as-pair to integer! any [select id "width" "100"] to integer! any 
  [select id "height" "100"]
	]

	x: to integer! any [select id "x" "0"]
	y: to integer! any [select id "y" "0"]

	scale-x: size/x / svg-size/x
	scale-y: size/y / svg-size/y

	;
	;	--- Helper functions
	;


 to-color: func [s [string!]] [	; converts a string in the form "#FFFFFF" 
 to a 4-byte tuple
		to tuple! load rejoin ["#{" next s "00}"]
	]


 to-byte: func [s [string!]] [	; converts a string with a value 0-1 
 to an inverted byte
		255 - to integer! 255 * to decimal! s
	]

	;
	;	--- Parse SVG defs
	;

	draw-blk: copy []

	append-style: function [
		command [string!] blk [block!]
	][
		x xy pen-color fill-color line-width mode size radius shape
		closed? matrix transf-command
	][
		xy: 0x0
		size: 0x0
		line-width: 1
		matrice: make block! []
		radius: none
		transf-command: none
		
		
		foreach [attr val] blk [
			switch attr [
				"transform" [print "tranform have been found" 
						;probe val halt 
						val: parse val "(),"
						transf-command: first val
						probe transf-command
						switch transf-command [
							"matrix" [ 
								foreach word val [
									if not find word "matrix"
									[ 
										insert tail matrice to-decimal word
									]
								]
							
							]
						]
				]
				"style" [
					foreach [attr val] parse val ":;" [
						switch/default attr [
						
							"font-size" [ ]
							"stroke" [
								switch/default first val [
									#"#" [pen-color: to-color val]
									#"n" [pen-color: none]
								][
									print ["Unknown stroke:" val]
								]
							]
							"stroke-width" [line-width: to decimal! val]
							"fill" [
								fill-color: switch/default first val [
									#"#" [to-color val]
									#"n" [none]
								][
									print ["Unknown fill value:" val]
									none
								]
							]
							"fill-rule" [
								mode: switch/default val [
									"evenodd"	['even-odd]
								][
									print ["Unknown fill-rule value:" val]
									none
								]
							]

       "stroke-opacity" [pen-color: any [pen-color 0.0.0.0] pen-color/4: 
       to-byte val]

       "fill-opacity" [fill-color: any [fill-color 0.0.0.0] fill-color/4: 
       to-byte val]
							"stroke-linejoin" [
								insert tail draw-blk switch/default val [
									"miter"		[compose [line-join miter]]
									"round"		[compose [line-join round]]
									"bevel"		[compose [line-join bevel]]
								][
									print ["Unknown stroke-linejoin value:" val]
									none
								]
							]
							"stroke-linecap" [
								insert tail draw-blk 'line-cap
								insert tail draw-blk to word! val
							]
						][
							print ["Unknown style:" attr]
						]
					]
				]
				"x"			[xy/x: scale-x * val]
				"y"			[xy/y: scale-y * val]
				"width"		[size/x: scale-x * val]
				"height"	[size/y: scale-y * val]
				"rx"		[print "rx"]
				"ry"		[radius: to decimal! val]
				"d"	[
					shape: copy []
					x: none
					closed?: false
					foreach token load val [
						switch/default token [
							M	[insert tail shape 'move]
							C	[insert tail shape 'curve]
							L	[insert tail shape 'line]
							z	[closed?: true]
						][

       unless number? token [print ["Unknown path command:" token]]

       either x [insert tail shape as-pair x scale-y * token x: none] [x: 
       scale-x * token]
						]
					]
				]
			]
		]
		insert tail draw-blk compose [
			pen (pen-color)
			fill-pen (fill-color)
			fill-rule (mode)
			line-width (line-width * min scale-x scale-y)
		]
		switch command [
			"rect" [
				insert tail draw-blk compose [box (xy) (xy + size)]
				if radius [insert tail draw-blk radius]
			]
			"path" [
				unless closed? [print "Path closed"]
				either transf-command <> none  [
					switch transf-command [

      "matrix" [insert tail draw-blk compose/only [ (to-word transf-command) 
      (matrice) shape (shape) reset-matrix]]
					]
				][
					insert tail draw-blk compose/only [shape (shape)]
			 	]
				]

   "g" [ print "Write here how to handle G insertion to Draw block" 

    insert tail draw-blk probe compose/only [reset-matrix (to-word transf-command) 
    (matrice)]
				
				]
			]
	]	
  
	probe defs
	foreach blk defs [
		switch first blk [
			"rect"	[append-style first blk second blk]
			"path"	[append-style first blk second blk]
			"g"		[
						print "key word" probe first blk  
						print "matrix and style in G" probe second blk  
						append-style first blk second blk 
						;print "what to draw in G" probe third blk
						foreach blk2 third blk [
							probe blk2
							switch first blk2[ 
								"path" [append-style first blk2 second blk2]
							]
						]
					]
		]
	]
	
	
probe draw-blk
	draw-blk
]

view make face [
	offset:	100x100
	size:	200x200
	action:	request-file/filter/only "*.svg"
	text:	rejoin ["SVG Demo [" last split-path action "]"]
	data:	read action
	color:	white
	effect:	compose/only [draw (load-svg data size)]
	edge: font: para: none
	feel: make feel [
		detect: func [face event] [
			if event/type = 'resize [
				insert clear face/effect/draw load-svg face/data face/size
				show face
			]
			if event/type = 'close [quit]
		]
	]
	options: [resize]
]

REBOL [
	Title:		"SVG Demo"
	Owner:		"Ashley G. Tr�ter"
	Version:	0.0.1
	Date:		21-Jun-2005
	Purpose:	"Loads and displays a resizeable SVG file."
	History: {
		0.0.1	Initial release
	}
	Notes: {
		Tested on very simple SVG icons
		Only a few basic styles / attributes / commands supported

  Does not handle sizes in units other than pixels (e.g. pt, in, cm, 
  mm, etc)

  SVG path has an optional close command, "z" ... AGG shape equivalent 
  auto-closes

  load-svg function needs to be totally refactored / optimized ... 
  *sample only*
	}
]

;	The following commands are available for path data:
;
;		M = moveto
;		L = lineto
;		H = horizontal lineto
;		V = vertical lineto
;		C = curveto
;		S = smooth curveto
;		Q = quadratic Belzier curve
;		T = smooth quadratic Belzier curveto
;		A = elliptical Arc
;		Z = closepath

;print: none	; comment out this line to enable debug messages

load-svg: function [svg-file [file! string!] size [pair!]] [

 id defs x y to-color to-byte draw-blk append-style svg-size scale-x 
 scale-y
][
	xml: either string? svg-file [parse-xml svg-file] [

  unless %.svg = suffix? svg-file [to error! "File has an invalid suffix!"]
		parse-xml read svg-file
	]

 unless xml/3/1/1 = "svg" [to error! "Could not find SVG header!"]

 ;unless find ["id" "xmlns"] xml/3/1/2/1 [to error! "Could not find 
 ID header!"]

 ;unless xml/3/1/3/1/1 = "defs" [to error! "Could not find DEFS header!"]

	id: xml/3/1/2
	defs: xml/3/1/3


	;
	;	--- Parse SVG id
	;

	svg-size: either find ["32pt" "48pt" "72pt"] select id "width" [
		switch select id "width" [
			"72pt"	[120x120]
			"48pt"	[80x80]
			"32pt"	[60x60]
		]
	][

  as-pair to integer! any [select id "width" "100"] to integer! any 
  [select id "height" "100"]
	]

	x: to integer! any [select id "x" "0"]
	y: to integer! any [select id "y" "0"]

	scale-x: size/x / svg-size/x
	scale-y: size/y / svg-size/y

	;
	;	--- Helper functions
	;


 to-color: func [s [string!]] [	; converts a string in the form "#FFFFFF" 
 to a 4-byte tuple
		to tuple! load rejoin ["#{" next s "00}"]
	]


 to-byte: func [s [string!]] [	; converts a string with a value 0-1 
 to an inverted byte
		255 - to integer! 255 * to decimal! s
	]

	;
	;	--- Parse SVG defs
	;

	draw-blk: copy []

	append-style: function [
		command [string!] blk [block!]
	][
		x xy pen-color fill-color line-width mode size radius shape
		closed? matrix transf-command
	][
		xy: 0x0
		size: 0x0
		line-width: 1
		matrice: make block! []
		radius: none
		transf-command: none
		
		
		foreach [attr val] blk [
			switch attr [
				"transform" [print "tranform have been found" 
						;probe val halt 
						val: parse val "(),"
						transf-command: first val
						probe transf-command
						switch transf-command [
							"matrix" [ 
								foreach word val [
									if not find word "matrix"
									[ 
										insert tail matrice to-decimal word
									]
								]
							
							]
						]
				]
				"style" [
					foreach [attr val] parse val ":;" [
						switch/default attr [
						
							"font-size" [ ]
							"stroke" [
								switch/default first val [
									#"#" [pen-color: to-color val]
									#"n" [pen-color: none]
								][
									print ["Unknown stroke:" val]
								]
							]
							"stroke-width" [line-width: to decimal! val]
							"fill" [
								fill-color: switch/default first val [
									#"#" [to-color val]
									#"n" [none]
								][
									print ["Unknown fill value:" val]
									none
								]
							]
							"fill-rule" [
								mode: switch/default val [
									"evenodd"	['even-odd]
								][
									print ["Unknown fill-rule value:" val]
									none
								]
							]

       "stroke-opacity" [pen-color: any [pen-color 0.0.0.0] pen-color/4: 
       to-byte val]

       "fill-opacity" [fill-color: any [fill-color 0.0.0.0] fill-color/4: 
       to-byte val]
							"stroke-linejoin" [
								insert tail draw-blk switch/default val [
									"miter"		[compose [line-join miter]]
									"round"		[compose [line-join round]]
									"bevel"		[compose [line-join bevel]]
								][
									print ["Unknown stroke-linejoin value:" val]
									none
								]
							]
							"stroke-linecap" [
								insert tail draw-blk 'line-cap
								insert tail draw-blk to word! val
							]
						][
							print ["Unknown style:" attr]
						]
					]
				]
				"x"			[xy/x: scale-x * val]
				"y"			[xy/y: scale-y * val]
				"width"		[size/x: scale-x * val]
				"height"	[size/y: scale-y * val]
				"rx"		[print "rx"]
				"ry"		[radius: to decimal! val]
				"d"	[
					shape: copy []
					x: none
					closed?: false
					foreach token load val [
						switch/default token [
							M	[insert tail shape 'move]
							C	[insert tail shape 'curve]
							S   [insert tail shape 'curv]
							L	[insert tail shape 'line]
							Q   [insert tail shape 'qcurve]
							T   [insert tail shape 'qcurv]
							z	[closed?: true]
							H   [insert tail shape 'hline]
							V   [insert tail shape 'vline]
							A   [insert tail shape 'arc]
						][

       unless number? token [print ["Unknown path command:" token]]

       either x [insert tail shape as-pair x scale-y * token x: none] [x: 
       scale-x * token]
						]
					]
				]
			]
		]
		insert tail draw-blk compose [
			pen (pen-color)
			fill-pen (fill-color)
			fill-rule (mode)
			line-width (line-width * min scale-x scale-y)
		]
		switch command [
			"rect" [
				insert tail draw-blk compose [box (xy) (xy + size)]
				if radius [insert tail draw-blk radius]
			]
			"path" [
				unless closed? [print "Path closed"]
				either transf-command <> none  [
					switch transf-command [

      "matrix" [insert tail draw-blk compose/only [ (to-word transf-command) 
      (matrice) shape (shape) reset-matrix]]
					]
				][
					insert tail draw-blk compose/only [shape (shape)]
			 	]
				]

   "g" [ print "Write here how to handle G insertion to Draw block" 

    insert tail draw-blk probe compose/only [reset-matrix (to-word transf-command) 
    (matrice)]
				
				]
			]
	]	
  
	probe defs
	foreach blk defs [
		switch first blk [
			"rect"	[append-style first blk second blk]
			"path"	[append-style first blk second blk]
			"g"		[
						print "key word" probe first blk  
						print "matrix and style in G" probe second blk  
						append-style first blk second blk 
						;print "what to draw in G" probe third blk
						foreach blk2 third blk [
							probe blk2
							switch first blk2[ 
								"path" [append-style first blk2 second blk2]
							]
						]
					]
		]
	]
	
	
probe draw-blk
	draw-blk
]

view make face [
	offset:	100x100
	size:	200x200
	action:	request-file/filter/only "*.svg"
	text:	rejoin ["SVG Demo [" last split-path action "]"]
	data:	read action
	color:	white
	effect:	compose/only [draw (load-svg data size)]
	edge: font: para: none
	feel: make feel [
		detect: func [face event] [
			if event/type = 'resize [
				insert clear face/effect/draw load-svg face/data face/size
				show face
			]
			if event/type = 'close [quit]
		]
	]
	options: [resize]
]

REBOL [
	Title:		"SVG Demo"
	Owner:		"Ashley G. Tr�ter"
	Version:	0.0.1
	Date:		21-Jun-2005
	Purpose:	"Loads and displays a resizeable SVG file."
	History: {
		0.0.1	Initial release
	}
	Notes: {
		Tested on very simple SVG icons
		Only a few basic styles / attributes / commands supported

  Does not handle sizes in units other than pixels (e.g. pt, in, cm, 
  mm, etc)

  SVG path has an optional close command, "z" ... AGG shape equivalent 
  auto-closes

  load-svg function needs to be totally refactored / optimized ... 
  *sample only*
	}
]

;	The following commands are available for path data:
;
;		M = moveto
;		L = lineto
;		H = horizontal lineto
;		V = vertical lineto
;		C = curveto
;		S = smooth curveto
;		Q = quadratic Belzier curve
;		T = smooth quadratic Belzier curveto
;		A = elliptical Arc
;		Z = closepath

;print: none	; comment out this line to enable debug messages

load-svg: function [svg-file [file! string!] size [pair!]] [

 id defs x y to-color to-byte draw-blk append-style svg-size scale-x 
 scale-y
][
	xml: either string? svg-file [parse-xml svg-file] [

  unless %.svg = suffix? svg-file [to error! "File has an invalid suffix!"]
		parse-xml read svg-file
	]

 unless xml/3/1/1 = "svg" [to error! "Could not find SVG header!"]

 ;unless find ["id" "xmlns"] xml/3/1/2/1 [to error! "Could not find 
 ID header!"]

 ;unless xml/3/1/3/1/1 = "defs" [to error! "Could not find DEFS header!"]

	id: xml/3/1/2
	defs: xml/3/1/3


	;
	;	--- Parse SVG id
	;

	svg-size: either find ["32pt" "48pt" "72pt"] select id "width" [
		switch select id "width" [
			"72pt"	[120x120]
			"48pt"	[80x80]
			"32pt"	[60x60]
		]
	][

  as-pair to integer! any [select id "width" "100"] to integer! any 
  [select id "height" "100"]
	]

	x: to integer! any [select id "x" "0"]
	y: to integer! any [select id "y" "0"]

	scale-x: size/x / svg-size/x
	scale-y: size/y / svg-size/y

	;
	;	--- Helper functions
	;


 to-color: func [s [string!]] [	; converts a string in the form "#FFFFFF" 
 to a 4-byte tuple
		to tuple! load rejoin ["#{" next s "00}"]
	]


 to-byte: func [s [string!]] [	; converts a string with a value 0-1 
 to an inverted byte
		255 - to integer! 255 * to decimal! s
	]

	;
	;	--- Parse SVG defs
	;

	draw-blk: copy []

	append-style: function [
		command [string!] blk [block!]
	][
		x xy pen-color fill-color line-width mode size radius shape
		closed? matrix transf-command
	][
		xy: 0x0
		size: 0x0
		line-width: 1
		matrice: make block! []
		radius: none
		transf-command: none
		
		
		foreach [attr val] blk [
			switch attr [
				"transform" [print "tranform have been found" 
						;probe val halt 
						val: parse val "(),"
						transf-command: first val
						probe transf-command
						switch transf-command [
							"matrix" [ 
								foreach word val [
									if not find word "matrix"
									[ 
										insert tail matrice to-decimal word
									]
								]
							
							]
						]
				]
				"style" [
					foreach [attr val] parse val ":;" [
						switch/default attr [
						
							"font-size" [ ]
							"stroke" [
								switch/default first val [
									#"#" [pen-color: to-color val]
									#"n" [pen-color: none]
								][
									print ["Unknown stroke:" val]
								]
							]
							"stroke-width" [line-width: to decimal! val]
							"fill" [
								fill-color: switch/default first val [
									#"#" [to-color val]
									#"n" [none]
								][
									print ["Unknown fill value:" val]
									none
								]
							]
							"fill-rule" [
								mode: switch/default val [
									"evenodd"	['even-odd]
								][
									print ["Unknown fill-rule value:" val]
									none
								]
							]

       "stroke-opacity" [pen-color: any [pen-color 0.0.0.0] pen-color/4: 
       to-byte val]

       "fill-opacity" [fill-color: any [fill-color 0.0.0.0] fill-color/4: 
       to-byte val]
							"stroke-linejoin" [
								insert tail draw-blk switch/default val [
									"miter"		[compose [line-join miter]]
									"round"		[compose [line-join round]]
									"bevel"		[compose [line-join bevel]]
								][
									print ["Unknown stroke-linejoin value:" val]
									none
								]
							]
							"stroke-linecap" [
								insert tail draw-blk 'line-cap
								insert tail draw-blk to word! val
							]
						][
							print ["Unknown style:" attr]
						]
					]
				]
				"x"			[xy/x: scale-x * val]
				"y"			[xy/y: scale-y * val]
				"width"		[size/x: scale-x * val]
				"height"	[size/y: scale-y * val]
				"rx"		[print "rx"]
				"ry"		[radius: to decimal! val]
				"d"	[
					shape: copy []
					x: none
					closed?: false
					if all [x not number? token] [

          insert tail shape x * either token = 'V [scale-y][scale-x]
  						    x: none
					]
					foreach token load val [
						switch/default token [
							M	[insert tail shape 'move]
							C	[insert tail shape 'curve]
							S   [insert tail shape 'curv]
							L	[insert tail shape 'line]
							Q   [insert tail shape 'qcurve]
							T   [insert tail shape 'qcurv]
							z	[closed?: true]
							H   [insert tail shape 'hline]
							V   [insert tail shape 'vline]
							A   [insert tail shape 'arc]
						][

       unless number? token [print ["Unknown path command:" token]]

       either x [insert tail shape as-pair x scale-y * token x: none] [x: 
       scale-x * token]
						]
					]
				]
			]
		]
		insert tail draw-blk compose [
			pen (pen-color)
			fill-pen (fill-color)
			fill-rule (mode)
			line-width (line-width * min scale-x scale-y)
		]
		switch command [
			"rect" [
				insert tail draw-blk compose [box (xy) (xy + size)]
				if radius [insert tail draw-blk radius]
			]
			"path" [
				unless closed? [print "Path closed"]
				either transf-command <> none  [
					switch transf-command [

      "matrix" [insert tail draw-blk compose/only [ (to-word transf-command) 
      (matrice) shape (shape) reset-matrix]]
					]
				][
					insert tail draw-blk compose/only [shape (shape)]
			 	]
				]

   "g" [ print "Write here how to handle G insertion to Draw block" 

    insert tail draw-blk probe compose/only [reset-matrix (to-word transf-command) 
    (matrice)]
				
				]
			]
	]	
  
	probe defs
	foreach blk defs [
		switch first blk [
			"rect"	[append-style first blk second blk]
			"path"	[append-style first blk second blk]
			"g"		[
						print "key word" probe first blk  
						print "matrix and style in G" probe second blk  
						append-style first blk second blk 
						;print "what to draw in G" probe third blk
						foreach blk2 third blk [
							probe blk2
							switch first blk2[ 
								"path" [append-style first blk2 second blk2]
							]
						]
					]
		]
	]
	
	
probe draw-blk
	draw-blk
]

view make face [
	offset:	100x100
	size:	200x200
	action:	request-file/filter/only "*.svg"
	text:	rejoin ["SVG Demo [" last split-path action "]"]
	data:	read action
	color:	white
	effect:	compose/only [draw (load-svg data size)]
	edge: font: para: none
	feel: make feel [
		detect: func [face event] [
			if event/type = 'resize [
				insert clear face/effect/draw load-svg face/data face/size
				show face
			]
			if event/type = 'close [quit]
		]
	]
	options: [resize]
]

hmm, you said it is like lisp - so yes, it is so ... I explained 
to my friend, that everything is a series/block (strings in Reichart's 
post). And you have basic set of commands to operate on strings - 
insert, delete, change, append, remove, find, first ... tenth ....... 
and you have 'do to do the code ...

The document "Rebol Essentials" starts with an explanation of value, 
word and block. Seems to be a good starting point. Haven't looked 
at how it introduces the syntax of system words later on. That is 
a crucial part. I want to find a subset of the 400 Rebol words that 
sould and can be learned first, giving the beginner a useful and 
powerful subset of instructions to start programming significant 
small apps.

I have the feeling that would be a very good starting point. I'm 
a little hazy on what is offered for parsing in Rebol at the moment. 
I'll look into that next. I think that once you have read a file 
into memory, it is in block form and you can use natives like "first", 
"next", "find" and so on on it. If so, then I would be going that 
way for sure.

Strings and blocks are both series, so first, next find etc work 
on both, but when you load you get a block and the units are values. 
When you read, you have a string and the units are characters.

Yes Patrick you have it right. The rules I gave would fail 
since you have multiple names/members

I would try to get away from the line by line mentality 
and try to break it into your conceptual record groupings
file, pages, sections, and details...

One trick I use is to replace a string delimiter for a record 
with a single char so parse returns a block of that record type. 

this is good because then when you work on each item in the block 
in turn
you know any fields you find do belong to this record and that 

you have not accidently skipped to a similar field in a later record.

something like this 


pages: read %file
replace/all/case pages "PAGE" "^L"
pages: parse/all pages "^L"

foreach page pages[
	p: first page
	page: find page newline
	replace/all/case page "NAME" "^L"
	sections: parse page "^L"
	foreach sec section [
		s: first section
		sec: find sec newline
		parse sec [
			any [thru "Member" copy detail to newline 
				newline (print [p tab s tab detail])
			]
		]
	]
]

just a thing Brian...

i don't like how map evolved. It lost his simplicity and inner speed.
Some gain like (either vs to-block) have been over rated.

some other bringing major speed regression  have been under rated.


i prefer the throw of an error during initialisation (ie. if find 
word  'output) instead of using the tricks of the embedded builded 
function.

janko, when I have chained calls which use options, I do this:

func [/opta /optb /options oblk][ 
	oblk: any [oblk copy [ ] ]
	if opta [append oblk 'opta]
	if optb [append oblk 'optb]

	; then use the block exclusively using find.
	if find oblk 'opta [print "option A supplied"
	if find oblk 'optb [print "option B supplied"

	; this way you can easily chain options 
	do-something/options oblk
]

REBOL[]


send: func [
	"Send a message to an address (or block of addresses)"
	;Note - will also be used with REBOL protocol later.
	address [email! block!] "An address or block of addresses"
	message "Text of message. First line is subject."
	/only   "Send only one message to multiple addresses"
	/header "Supply your own custom header"
	header-obj [object!] "The header to use"
	/attach "Attach file, files, or [.. [filename data]]"
	files [file! block!] "The files to attach to the message"
	/subject "Set the subject of the message"
	subj "The subject line"
	/show "Show all recipients in the TO field"
	/local smtp-port boundary make-boundary tmp from
][
	make-boundary: does []

	if file? files [files: reduce [files]] ; make it a block
	if email? address [address: reduce [address]] ; make it a block
	message: either string? message [copy message] [mold message]

	if not header [                 ; Clone system default header
		header-obj: make system/standard/email [

   subject: any [subj copy/part message any [find message newline 50]]
		]
	]
	if subject [header-obj/subject: subj]
	either none? header-obj/from [

  if none? header-obj/from: from: system/user/email [net-error "Email 
  header not set: no from address"]
		if all [string? system/user/name not empty? system/user/name][
			header-obj/from: rejoin [system/user/name " <" from ">"]
		]
	][
		from: header-obj/from
	]
	if none? header-obj/to [
		header-obj/to: tmp: make string! 20
		if show [
			foreach email address [repend tmp [email ", "]]
			clear back back tail tmp
		]
	]
	if none? header-obj/date [header-obj/date: to-idate now]

	if attach [

  boundary: rejoin ["--__REBOL--" system/product "--" system/version 
  "--" checksum form now/precise "__"]
		header-obj/MIME-Version: "1.0"

  header-obj/content-type: join "multipart/mixed; boundary=" [{"} skip 
  boundary 2 {"}]
		message: build-attach-body message files boundary
	]

	;-- Send as an SMTP batch or individually addressed:
	smtp-port: open [scheme: 'esmtp]
	either only [ ; Only one message to multiple addrs
		address: copy address
		; remove non-email values
		remove-each value address [not email? :value]

  message: head insert insert tail net-utils/export header-obj newline 
  message
		insert smtp-port reduce [from address message]
	] [
		foreach addr address [
			if email? addr [
				if not show [insert clear header-obj/to addr]

    tmp: head insert insert tail net-utils/export header-obj newline 
    message
				insert smtp-port reduce [from reduce [addr] tmp]
			]
		]
	]
	close smtp-port
]

resend: func [
	"Relay a message"
	to from message /local smtp-port
][
	smtp-port: open [scheme: 'esmtp]
	insert smtp-port reduce [from reduce [to] message]
	close smtp-port
]

build-attach-body: function [
	{Return an email body with attached files.}
	body [string!] {The message body}

 files [block!] {List of files to send [%file1.r [%file2.r "data"]]}
	boundary [string!] {The boundary divider}
][
	make-mime-header
	break-lines
	file
	val
][
	make-mime-header: func [file] [
		net-utils/export context [

   Content-Type: join {application/octet-stream; name="} [file {"}]
			Content-Transfer-Encoding: "base64"

   Content-Disposition: join {attachment; filename="} [file {"^/}]
		]
	]
	break-lines: func [mesg data /at num] [
		num: any [num 72]
		while [not tail? data] [
			append mesg join copy/part data num #"^/"
			data: skip data num
		]
		mesg
	]
	if not empty? files [
		insert body reduce [boundary "^/Content-type: text/html^/^/"]
		append body "^/^/"
		if not parse files [
			some [
				(file: none)
				[
					set file file! (val: read/binary file)
					| into [
						set file file!
						set val skip ;anything allowed
						to end
					]
				] (
					if file [
						repend body [
							boundary "^/"
							make-mime-header any [find/last/tail file #"/" file]
						]
						val: either any-string? val [val] [mold :val]
						break-lines body enbase val
					]
				)
			]
		] [net-error "Cannot parse file list."]
		append body join boundary "--^/"
	]
	body
]

That would lead into same bytecode. I was thinking about something 
else... something like:
set-if-undefined something defaultValue 

but cannot find name for it. But because it's usually inside function, 
maybe I could add default value settings inside fhe func definition 
block. But I'm not sure now if I need it so much.

ints-to-sbs: func[

 ints [block!]	 "Block of integers, that I want to convert to SBs"

 /complete l-bits "Completes the bit-stream => l-bits stores the nBits 
 info of the values"
	;/maxb mb
	/local b b2 l bits sb
][
	ints: reduce ints
	max-bits: 0
	bits: make block! length? ints
	foreach i ints [
		;b: enbase/base load rejoin ["#{" to-hex i "}"] 2
		b: enbase/base head reverse int-to-ui32 i 2
		b: find b either i < 0 [#"0"][#"1"]
		b: copy either none? b [either i >= 0 ["00"]["11"]][back b]
		;insert b either i >= 0 [#"0"][#"1"]
		if max-bits < l: length? b [max-bits: l]
		append bits b
	]
	foreach b bits [
		if max-bits > l: length? b [
			insert/dup b b/1 max-bits - l
		]
	]
	either complete [
		sb: int-to-bits max-bits l-bits
		foreach b bits [insert tail sb b]
		sb
	][	
		bits
	]
]

int-to-FB: func[i /local x y fb][
	x: to integer! i
	y: to integer! (either x = 0 [i][i // x]) * 65535

 fb: rejoin [either x = 0 ["0"][first ints-to-sbs to block! x] int-to-bits 
 y 16]
	if all [x = 0 i < 0][fb/1: #"1"]
	fb
]

REBOL []


use [fixup-rule label-rule label-fixup-rule label-error-rule here] 
[
    ; Initialize the intermediate rules
    label-rule: make block! 0
    label-fixup-rule: make block! 0
    label-error-rule: make block! 0
    ; Build the fixup-rule based on the opcode-rule
    fixup-rule: copy/deep rebcode*/opcode-rule
    parse fixup-rule [
        some [
            here: 
            lit-word! block! '| (

                unless find ['bra 'brat 'braf] here/1 [insert here/2 [label-error-rule 
                |]]
            ) |
            lit-word! 'word! '| (

                unless 'label = here/1 [here/2: [label-error-rule | word!]]
            ) |
            lit-word! | '| | 'block! | 'series! |
            'word! (here/1: [label-error-rule | word!]) |
            'any-type! (here/1: [label-fixup-rule | any-type!]) |
            into ['integer! '| 'word! | 'word! '| 'integer!] (
                insert here/1 [label-fixup-rule |]
            ) |
            block! (insert here/1 [label-error-rule |])
        ]
    ]
    ; Replace the fix-bl function

    rebcode*/fix-bl: func [block /local labels here there label rule] 
    bind [
        labels: make block! 16
        block-action: :fix-bl
        if debug? [print "=== Fixing binding and labels... ==="]
        parse block [
            some [
                here:
                subblock-rule (here/1: bind here/1 words)
                |

                'label word! (here/1: bind here/1 words insert insert tail labels 
                here/2 index? here)
                |
                'offset word! integer! (
                    here/1: bind 'set words
                    here/3: 3 + here/3 + index? here

                    if (here/3 < 1) or (here/3 > 1 + length? block) [
                        error/with here "Offset out of bounds:"
                    ]
                )
                |
                opcode-rule (here/1: bind here/1 words)
                |
                skip (error here)
            ]
        ]
        either 0 < length? labels [
            label-rule: make block! length? labels

            foreach [key val] labels [insert insert tail label-rule to-lit-word 
            key '|]
            clear back tail label-rule

            label-fixup-rule: [there: label-rule (there/1: 2 + select labels 
            there/1)]

            label-error-rule: [label-rule (error/with here "Cannot use label 
            here:")]
            rule: fixup-rule
        ] [
            rule: opcode-rule
        ]
        parse block [
            some [
                here:
                ['bra word! | 'brat word! | 'braf word!] (

                    if not label: select labels here/2 [error/with here "Missing label:"]
                    here/2: label - index? here
                )
                |
                rule
                |
                skip (error here)
            ]
        ]
    ] rebcode*
]

Yes, compilation must be done on block-level, and preferably after 
the block has already been interpret. to find function-boundaries. 
but self could go half as fast as c, and hotspot even faster. while 
switching back and forth between compiled and interpreted code.

other thing is, if we should support /object as original scheme did? 
Even  with odbc, some time ago, I simply created map-record function, 
which mapped record to object, for easier access (block position 
independent) .... dunno if you find that possibility usefull though 
....

Replace the column-text block in the SQL function with:

	[(
		either direct [
			[*column-text (sid) idx]
		][
			[
				s: v: *column-text (sid) idx
				while [s: find s {""}] [change/part s "" 2]
				load v
			]
		]
	)]

I've added this to the next build.

Hi Ashley, while trying to find a minimal code example ... I found 
the error ... ;-) 

That's the error message ...
** User Error: SQLite SQL logic error or missing database
** Near: make error! reform ["SQLite" error]

And it was caused by:

      if string? face/user-data [
         if error? set/any 'err try [

            set pAddress-disp first rule compose [pAddress get guid = (face/user-data) 
            *]
	; rule creates an sql string and starts calls 'sql with it
	; yadda yadda yadda ...
         ]
      ][probe disarm err]

Do you find the error??? 

Somehow the [probe disarm err] block moved to the wrong if ... 


I don't know how this could trigger _this_ error, but after I moved 
the block the error has not occurred again.

Feature request:  I propose SELECT's arguments should reversed, to 
be like SWITCH. I remember SWITCH being implemented and arguing to 
put the VALUE argument before the CASES block to make it easy to 
find.

I've been wondering about an extension to EXTRACT as I haven't been 
able to find this particular functionality anywhere else. If it exists, 
then I'm wrong and you can ignore this.


I would like to propose adding a /size refinement to set the number 
of values extracted at each point. This would make it very easy to 
split a string in equal-sized chunks. It could also be used to retrieve 
equal sized parts of a set of database records. Combining this with 
/index, I think this could be very useful.

Here's how I would like it to work:

>> block: [1 2 3 4 5 6 7 8 9]
>> extract block 2
== [1 3 5 7 9]
>> extract block 4
== [1 5 9]
>> extract/index block 2 2
== [2 4 6 8 none]

The refinement at work:

>> extract/size block 4 2
== [[1 2] [5 6] [9 none]]
>> num: to-string 123456789
== "123456789"
>> extract num 3
== [#"1" #"4" #"7"]
>> extract/size num 3 1
== ["1" "4" "7"]
>> extract/size num 3 2
== ["12" "45" "78"]
>> extract/size num 3 3
== ["123" "456" "789"]
>> extract/size num 3 5
== ["12345" "45678" "789"]
>> extract/size/index num 3 5 2
== ["23456" "56789" "89"]
>> extract/size num 3 12
== ["123456789"]

/size would always return a block of series.

rebol [
	purpose: "Demonstrate how to use the findany function."
	note:  {This is a function I would like included in Rebol3.
		One of you experts (I don't remember who) made this function 

                for me, and I use it all the time. Do you see any ways it can
		be improved before I submit it? --- Louis
	}
]

s: "findany will return true if it finds in this sentence any of 
the strings you enter in the request box."
print [s newline]

forever [

 bs: copy parse (request-text/title "Enter the strings you want to 
 find separated by a space.") none

	findany: func [ 
	     "Searches string x for any substring found in block ys."
	     x [string!] "string"
	     ys [block!] "block of substrings"
	    /local pos
	] [
	    foreach y ys [
	         if pos: find x y [return pos]
	     ]
	]

either findany s bs [print true][print false]

]
halt

rebol [
	purpose: "Demonstrate how to use the findall function."
	note:  {This is a function I would like included in Rebol3.
		This is my function. Do you see any ways it can
		be improved before I submit it? --- Louis}
]

s: "findall will return true only if it finds in this sentence all 
the strings you enter in the request box."
print [s newline]

forever [

 bs: copy parse (request-text/title "Enter the strings you want to 
 find separated by a space.") none

	findall: func [
		"Seaches string s for all substrings find in block bs."
		s [string!] "string to search in"
		bs [block!] "block of strings to search for"
	][
		findit: func [
			s [string!] "string to search in"
		        b [string!] "string to search for" 
		][
			if find s b [either find s b [true][false]]
		]
		foreach b bs [either findit s b [true][break/return false]]
	]

either findall s bs [print true][print false]

]
halt

I have a button "Edit" which imperfectly shows you the dialect source 
( strings lose their quote marks).  Not formatted though.  And save 
which is supposed to re-render any changes doesn't work .. because 
the data needs to be converted from text to a block, and without 
the quote marks for the text, it dies.  Too late for me to find a 
fix.

That's because the DEBUG mode is activated by default in these beta 
releases. To get ride of it, just edit the httpd.cfg file , find 
the webapp "/testapp" option block and remove the 'debug keyword 
 (then restart the server).

1) Add you service in %UniServe/services/
2) Edit %Cheyenne/cheyenne.r

3) Add in the 'set-cache block inside the %services/ section, the 
name of your service.
4) In 'do-cheyenne-app function :


- find the line "do-cache %HTTPd.r" and add after that : "do-cache 
%your-service.r"

- find the line "control/start/only 'task-master none" and add after 
that :
    "control/start/only 'your-service-name none"

to get rid of the first none, it's resuired to add:
locales-dir %locales/

into webapp block... the second none is difficult. at least i really 
cannot find, how to set the 'lang in locales. The 'default-lang  
in 'webapp seems not to be working and in main httpd.conf as well. 
It must be a bug (or missing feature) in public version of the Cheyenne.

rebol [
	title: "explore.r"
	version 1.0
	date: 2009-03-19
	author: "Maxim Olivier-Adlhoch"
	copyright: "2009(c)Maxim Olivier-Adlhoch"
	tested: "win xp"

 notes: "Add any dir to the dirs block.  options are self explanatory"
]

dirs: [
	%/C/ []
	%"/C/program files/" [expand]
	"%tmp%" [label "temp dir"]
	"" [ label "my documents"]
]

blk: []

explore-dir: func [path expand? /local cmd][

 call/shell rejoin [" explorer " either expand? ["/n,/e,"]["/n,"] 
 path ]
]

ctr: 1
foreach [item opts] dirs [
	ctr: ctr + 1
	expand?: found? find opts 'expand
	label: any [select opts 'label to-local-file item]
	append blk compose/deep [ 
		pad 20 
		(to-set-word setw: rejoin ["dir" ctr]) check (expand?) 
		pad 20 

  btn 200 left (label) [ explore-dir to-local-file item get in (to-word 
  setw) 'data ]
	]
	append blk 'return
]


view layout compose [across vtext right "expand?" vtext "folder" 
 return (blk)]